home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / simula1a / basdecla.bas next >
Encoding:
BASIC Source File  |  1999-09-13  |  2.7 KB  |  94 lines
  1. Attribute VB_Name = "basDeclares"
  2. Option Explicit
  3.  
  4. Private PID As Long
  5. Public IsResond As String
  6.  
  7. Public Const PROCESS_ALL_ACCESS = &H1F0FFF
  8.  
  9. Public Declare Function OpenProcess Lib "kernel32" _
  10.     (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, _
  11.     ByVal dwProcessId As Long) As Long
  12.     
  13. Public Declare Function TerminateProcess Lib "kernel32" _
  14.     (ByVal hProcess As Long, ByVal uExitCode As Long) As Long
  15.     
  16. Private Const WM_NULL = &H0
  17. Private Const SMTO_BLOCK = &H1
  18. Private Const SMTO_ABORTIFHUNG = &H2
  19.  
  20. Public Declare Function EnumWindows Lib "user32" (ByVal lpEnumFunc As Long, _
  21.     ByVal lParam As Long) As Long
  22.     
  23. Private Declare Function GetWindowThreadProcessId Lib "user32" _
  24.     (ByVal hwnd As Long, lpdwProcessId As Long) As Long
  25.     
  26. Private Declare Function SendMessageTimeout Lib "user32" _
  27.     Alias "SendMessageTimeoutA" (ByVal hwnd As Long, _
  28.     ByVal msg As Long, ByVal wParam As Long, ByVal lParam As Long, _
  29.     ByVal fuFlags As Long, ByVal uTimeout As Long, _
  30.     pdwResult As Long) As Long
  31.  
  32. Private Function fEnumWindowsCallBack(ByVal hwnd As Long, ByVal lpData As Long) As Long
  33. Dim lThreadId  As Long
  34. Dim lProcessId As Long
  35. '
  36. ' This callback function is called by Windows (from the EnumWindows
  37. ' API call) for EVERY window that exists until fEnumWindowsCallBack
  38. ' is set False.
  39. '
  40. fEnumWindowsCallBack = 1
  41. lThreadId = GetWindowThreadProcessId(hwnd, lProcessId)
  42.  
  43. If lProcessId = PID Then
  44.     Call strCheck(hwnd)
  45.     fEnumWindowsCallBack = 0
  46. End If
  47.  
  48. End Function
  49.  
  50. Public Function fEnumWindows(clsPID As Long) As Boolean
  51. Dim hwnd As Long
  52.  
  53. PID = clsPID
  54.  
  55. ' The EnumWindows function enumerates all top-level windows
  56. ' on the screen by passing the handle of each window, in turn,
  57. ' to an application-defined callback function. EnumWindows
  58. ' continues until the last top-level window is enumerated or
  59. ' the callback function returns FALSE.
  60. '
  61.  Call EnumWindows(AddressOf fEnumWindowsCallBack, hwnd)
  62. End Function
  63.     
  64.  
  65. Private Function strCheck(ByVal lhwnd As Long)
  66. Dim lResult As Long
  67. Dim lReturn As Long
  68. Dim strRunning As String
  69.  
  70. ' If no app started, get out.
  71. '
  72. If lhwnd = 0 Then Exit Function
  73. '
  74. ' Check the status of the application specifying
  75. ' a timeout period of 1 second (1000 miliseconds).
  76. '
  77. ' SMTO_ABORTIFHUNG Returns without waiting for the
  78. '       time-out period to elapse if the receiving
  79. '       process appears to be in a "hung" state.
  80. '
  81. ' SMTO_BLOCK Prevents the calling thread from processing
  82. '       any other requests until the function returns.
  83. '
  84. lReturn = SendMessageTimeout(lhwnd, WM_NULL, 0&, 0&, SMTO_ABORTIFHUNG And SMTO_BLOCK, 1000, lResult)
  85.  
  86. If lReturn Then
  87.     IsResond = "Responding"
  88. Else
  89.     IsResond = "Not Responding"
  90. End If
  91. End Function
  92.  
  93.  
  94.